home *** CD-ROM | disk | FTP | other *** search
/ Precision Software Appli…tions Silver Collection 4 / Precision Software Applications Silver Collection Volume 4 (1993).iso / database / sr_info.exe / ONFIELD.PRG < prev    next >
Text File  |  1990-04-11  |  5KB  |  155 lines
  1. ***************************************************************************
  2. **  ONFIELD.PRG
  3. **  (C) Copyright 1990, Sub Rosa Publishing Inc.
  4. **  A demonstration program provided to SR-Info and VP-Info users.
  5. **  This program may be copied freely. If it is used in commercial code,
  6. **  please credit the source, Sub Rosa Publishing Inc.
  7. **
  8. **  ONFIELD demonstrates the use of the ON FIELD command along with a variety
  9. **  of Info commands and functions.
  10. **  ONFIELD is compatible with all current versions of SR-Info and VP-Info.
  11. **
  12. **  ONFIELD displays a menu, determines the choice made, and takes
  13. **  action depending both on the selection and the key used to make
  14. **  the selection.
  15. **
  16. **  Bernie Melman
  17. **  April 1,1990
  18. ***************************************************************************
  19. ** ON FIELDS DEMONSTRATION
  20. ** The ON FIELD/ENDON structure is unique to VP-Info and SR-Info.
  21. ** It is hoped that this sample program will help illustrate how
  22. ** this strucure can be used.
  23. **
  24. ** Many application have the following steps in common:
  25. **   i) Accept input information - often by the screenful.
  26. **  ii) Validate the information - requesting additional or corrected
  27. **      information as required.
  28. ** iii) Process the information.
  29. **  iv) Report the results.
  30. ** Using the ON FIELD/ENDON structure combines steps i and ii in a very
  31. ** natural way, allowing field by field verificatioin as information
  32. ** is entered.
  33. **
  34. ** Input fields can defined by a series of @ x,y get statements, or by
  35. ** a 'painted' screen using the TEXT/ENDTEXT structure, or even a combination
  36. ** of the two. VP-Info creats an internal GET TABLE listing all active input
  37. ** fields. Input is activated by a READ command. If there is an ON FIELD/ENDON
  38. ** structure before the READ statement, it is referanced as part of the READ
  39. ** proces.
  40. ** The GET TABLE consists of entries numbered 0 to 65. Fields 1 to 64 refer
  41. ** to the actual input fields. Field 0 refers to a set of preprocessing
  42. ** commands, while field 65 refers to a set of post-processing commands.
  43. *
  44. ***************************************************************************
  45. * initialize variables
  46. CUSTCODE = blank(8)
  47. UNIT_WT = 5.65
  48. MIN_WT = 5.4
  49. MAX_WT = 5.85
  50. UNITS_SOLD = 0.0
  51. NET_WT = 0
  52. UNIT_PRICE = 6.48
  53. MIN_PRICE = 5.50
  54. MAX_PRICE = 8.00
  55. NET_PRICE = 0
  56. *
  57. ERASE; clears screen
  58. WINDOW 5,10,18,72 DOUBLE ; note no ',' before keyword DOUBLE
  59. * 'paint' text screen.
  60. TEXT
  61. .. custcode   !!!!!!!!
  62. .. unit_wt      99.999
  63. .. units_sold  999
  64. .. net_wt    99999.999
  65. .. unit_price  999.99
  66. .. net_price 99999.99
  67. .. min_price   $$9.99
  68. .. max_price   $$9.99
  69. .. min_wt      999.99
  70. .. max_wt      999.99
  71.  
  72.                       WIDGETS OF THE WORLD
  73.                    ORDER SUMMARY DEMO PROGRAM
  74.                  (Experiment with illegal values)
  75.  
  76.        UNITS SOLD: @units_sold    CUSTOMER CODE: @custcode
  77.                    MINIMUM    MAXIMUM     ACTUAL
  78.       UNIT WEIGHT: #min_wt    #max_wt     @unit_wt
  79.        UNIT PRICE: #min_price #max_price  @unit_price
  80.  
  81.            NET WEIGHT: @net_wt
  82.             NET PRICE: @net_price
  83.  
  84. ENDTEXT
  85. * build the ON FIELD structure
  86. ON field
  87. FIELD 0
  88.    @ 19,22 say  ' Enter QUIT to exit '
  89.    :FIELD = field(custcode)
  90. FIELD custcode
  91. * customer code could be verified here - and customer file alligned
  92.    IF custcode = 'QUIT'
  93.       :FIELD = 65  ; i.e. fall out of the READ
  94.    ELSE
  95.       @ 19,22 say blank(38,205) ; rebuild double box
  96.       @ 19,22 say ' Enter Negative Value to Exit. '
  97.       :FIELD = field(units_sold)
  98.    ENDIF
  99. FIELD units_sold
  100.    DO CASE
  101.    CASE  units_sold < 0 ; user wants out
  102.       :FIELD = 65
  103.    CASE  units_sold > 300
  104.       RING
  105.       RING
  106.       @ 19,22 say blank(38,205) ; rebuild double box
  107.       @ 19,22 say " I won't believe more than 300 !!! "
  108.       :FIELD = field(units_sold)
  109.    CASE units_sold >=0 .and. units_sold < 20
  110.       RING
  111.       @ 19,22 say blank(38,205) ; rebuild double box
  112.       @ 19,22 say  ' Oh! Dissapointing sales volume !!! '
  113.       :FIELD = field(unit_wt)
  114.    CASE units_sold > 50 .and. units_sold < 300
  115.       ?? chr(7) ; RING does the same thing as this line
  116.       @ 19,22 say blank(38,205) ; rebuild double box
  117.       @ 19,22 say  ' Hey, Good Work !!! '
  118.       :FIELD = field(unit_wt)
  119.    OTHERWISE
  120.       @ 19,22 say  blank(38,205)
  121.       :FIELD = field(unit_wt)
  122.    ENDCASE
  123. FIELD unit_wt
  124.    IF unit_wt < min_wt .or. unit_wt > max_wt
  125.       ?? chr(7),chr(7)
  126.       @ 19,22 say blank(38,205) ; rebuild double box
  127.       @ 19,22 say  ' Oops, weight out of range! '
  128.       :FIELD = field(unit_wt)
  129.    ELSE
  130.       NET_WT = unit_wt * units_sold
  131.       :FIELD = field(unit_price)
  132.       @ 19,22 say blank(38,205) ; rebuild double box
  133.    ENDIF
  134. FIELD unit_price
  135.    IF unit_price < min_price .or. unit_price > max_price
  136.       RING
  137.       RING
  138.       @ 19,22 say blank(38,205) ; rebuild double box
  139.       @ 19,22 say  ' Oops, price out of range! '
  140.       :FIELD = field(unit_price)
  141.    ELSE
  142.       NET_PRICE = unit_price * units_sold
  143.       :FIELD = 65
  144.    ENDIF
  145. FIELD 65
  146.    RING
  147.    @ 19,22 say blank(38,205) ; rebuild double box
  148.    @ 19,22 say  ' Press any key to end demo. '
  149. ENDON
  150. READ
  151. DUMMY = inkey()
  152. WINDOW
  153. *
  154. *                    *** ONFIELD.PRG ***
  155.